home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / tools / allocrj.com / ALLOCDEM.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-04-09  |  11.5 KB  |  356 lines
  1. {**************************************************************************
  2.   Some of the DOS memory routines presented in ALLOC.PAS and demonstrated
  3.   in ALLOCDEM.PAS, were initially uploaded by Richard Sadowsky as DOSMEM
  4.   (version 1.1), and released to the public domain on 8/22/88.  That
  5.   unit was especially appreciated by those of us who code in both
  6.   Turbo Pascal and Turbo C.  30-40% of the code in the ALLOC unit was
  7.   taken from DOSMEM.
  8.  
  9.   However, DOSMEM had its DOS routines written in assembly language,
  10.   and required use as external *.obj files.  Since I frequently forget
  11.   *.obj files when I'm working at differenct locations, and more importantly,
  12.   since I'm not good at assembly, I re-wrote the routines using interrupts,
  13.   calling the new unit ALLOC.PAS, in deference to Turbo C's <alloc.h>.  In
  14.   addition, a few other modifications were made to the error-handling routine,
  15.   as well as making the interrupt routines internal to the unit, re-naming
  16.   a few things, and adding calloc, which has as its argument, the desired
  17.   fillpattern with which to clear the RAM block (unlike C's calloc).
  18.   See ALLOC.PAS for modification history.
  19.  
  20.   Robert L. Jones,  CIS [71251,2566]
  21.   Version 1.4 released to the public domain 4/9/89.
  22. ***************************************************************************}
  23.  
  24.  
  25. {$M 1024,0,0}
  26. {           \ memory should be returned to DOS to enable ALLOC functions to
  27.               work, since Turbo Pascal will assign any extra RAM to the
  28.               heap, which isn't accessible to the ALLOC routines.  This does
  29.               not mean that a portion cannot be retained for the heap, but
  30.               rather that enough RAM must be available for DOS if you want
  31.               to allocate some of it using ALLOC.  See ALLOC.PAS for details.
  32.  
  33.               if you want to see why it's required, temporarily erase
  34.               "$M" and run the demo.
  35. }
  36.  
  37. {$R-,S-}
  38.  
  39.  
  40. program allocdemo;
  41.  
  42. uses  crt, ALLOC;
  43.  
  44. const
  45.   ScreenSize = 4000;
  46.   MaxNum     = 4;
  47.  
  48. var
  49.   p, videoptr  : pointer;
  50.   pbuffer      : array[1..MaxNum] of pointer;
  51.   initialRAM,
  52.      currRAM   : longint;
  53.   i            : integer;
  54.   j, count     : byte;
  55.   ch           : char;
  56.  
  57.  
  58. function initvideo : pointer;
  59. { initialize a video pointer, based on run-time determination of adapter type }
  60. const
  61.   AdapterSeg = $0000;
  62.   AdapterOff = $0449;
  63.   Monochrome = 7;
  64.   Mono       = $b000;
  65.   Color      = $b800;
  66. var
  67.   videoseg   : word;
  68. begin
  69.   if (Mem[AdapterSeg:AdapterOff] = Monochrome) then
  70.     videoseg := Mono
  71.   else
  72.     videoseg := Color;
  73.   initvideo  := ptr(videoseg,0);
  74. end;
  75.  
  76.  
  77. procedure initmempointers;
  78. { by initializing all of your memory pointers, you can avoid the potential  }
  79. { headaches of trying to free or reallocate a pointer which has not been    }
  80. { allocated by DosAlloc(), and points to who knows where.  the actual error }
  81. { monitoring occurs in the free(), realloc(), farfree(), and farrealloc()   }
  82. { routines in ALLOC.PAS.                                                    }
  83. begin
  84.   p := NIL ;
  85.   for i := 1 to MaxNum do
  86.     pbuffer[i] := NIL;
  87. end;
  88.  
  89.  
  90. procedure demoerrors;
  91. { an unexciting demo of memory error handling of pointers assigned to NIL }
  92. begin
  93.   textcolor(lightred);
  94.   p := realloc(p, 32768);
  95.   if (p = NIL) then
  96.     writeln('you cannot realloc() a pointer assigned to NIL')
  97.   else
  98.     writeln('memory reallocation was OK');
  99.   free(p);
  100.   if (AllocError <> 0) then
  101.     writeln('you cannot free a pointer assigned to NIL')
  102.   else
  103.     writeln('memory was freed');
  104.  
  105.   p := malloc(1024);
  106.   if (p = NIL) then
  107.     writeln('you can alloc() a pointer assigned to NIL; but error occurred')
  108.   else
  109.     writeln('memory allocation was OK');
  110.   free(p);
  111.   if (AllocError <> 0) then
  112.     writeln('you cannot free a pointer assigned to NIL')
  113.   else
  114.     writeln('memory was freed');
  115.   free(p);
  116.   if (AllocError <> 0) then
  117.     writeln('you cannot free a pointer assigned to NIL')
  118.   else
  119.     writeln('memory was freed');
  120.   writeln;
  121.   writeln;
  122.   textcolor(yellow);
  123.   write('press any key to continue demo...');
  124.   ch := readkey;
  125.   textcolor(lightgray);
  126.  
  127.   { start from scratch again }
  128.   clrscr;
  129.   initmempointers;
  130. end;
  131.  
  132.  
  133. begin
  134.   clrscr;
  135.  
  136.   { initial all pointers used for memory allocation }
  137.   initmempointers;
  138.  
  139.  
  140.   { un-comment this section to see how initializing to NIL is used to handle }
  141.   { errors of incorrect attempts to use memory pointers which are improperly }
  142.   { allocated.  for example, if you try to reallocate memory, which DOS has  }
  143.   { not allocated through the use of malloc()/calloc(), unpredictable things }
  144.   { could happen to you.  by simply creating your own pointer initialization }
  145.   { procedure, you should avoid any problems.                                }
  146.  
  147.  (*  demoerrors; *)
  148.  
  149.  
  150.   { show the initial memory status }
  151.   textcolor(lightred);
  152.   writeln('Initial memory conditions');
  153.   textcolor(lightgray);
  154.   writeln(coreleft,' bytes free in the near heap');
  155.   initialRAM := farcoreleft;
  156.   writeln(initialRAM,' bytes free in the far heap');
  157.   writeln;
  158.  
  159.   { demo calloc(fp, size), note that fp can be any byte; 0 clears the RAM }
  160.   textcolor(lightred);
  161.   writeln('Now allocating memory with calloc');
  162.   p := calloc(0, 32768);              { get $8000 = 32k or 32768 }
  163.   textcolor(lightgray);
  164.   if (p = NIL) then
  165.     writeln('calloc error = ',MemError[AllocError])
  166.   else begin
  167.     currRAM := farcoreleft;
  168.     writeln(initialRAM-currRAM,' bytes allocated');
  169.     writeln(currRAM,' bytes free');
  170.   end;
  171.  
  172.   { demo free }
  173.   textcolor(lightred);
  174.   writeln('Now freeing reserved memory');
  175.   free(p);
  176.   textcolor(lightgray);
  177.   if (AllocError <> 0) then
  178.     writeln('free farmalloc error = ',MemError[AllocError])
  179.   else
  180.     writeln('previously allocated memory freed');
  181.   writeln(farcoreleft,' bytes free');
  182.   writeln;
  183.  
  184.   { demo farmalloc }
  185.   textcolor(lightred);
  186.   writeln('Now allocating memory with farmalloc');
  187.   p := farmalloc($40000);               { get $40000 = 256k or 262144 }
  188.   textcolor(lightgray);
  189.   if (p = NIL) then
  190.     writeln('farmalloc error = ',MemError[AllocError])
  191.   else begin
  192.     currRAM := farcoreleft;
  193.     writeln(initialRAM-currRAM,' bytes allocated');
  194.     writeln(currRAM,' bytes free');
  195.   end;
  196.  
  197.   { demo farrealloc }
  198.   textcolor(lightred);
  199.   writeln('Now reallocating memory with farrealloc');
  200.   p := farrealloc(p,$20000);           { get $20000 = 128k or 131072 }
  201.   textcolor(lightgray);
  202.   if (p = NIL) then
  203.     writeln('farrealloc error = ',MemError[AllocError])
  204.   else begin
  205.     currRAM := farcoreleft;
  206.     writeln('resized to ', initialRAM-currRAM,' bytes');
  207.     writeln(currRAM,' bytes free');
  208.   end;
  209.   writeln;
  210.  
  211.   { demo realloc }
  212.   textcolor(lightred);
  213.   writeln('Now reallocating memory with realloc');
  214.   p := realloc(p, 32768);              { get $8000 = 32k or 32768 }
  215.   textcolor(lightgray);
  216.   if (p = NIL) then
  217.     writeln('realloc error = ',MemError[AllocError])
  218.   else begin
  219.     currRAM := farcoreleft;
  220.     writeln('resized to ', initialRAM-currRAM,' bytes');
  221.     writeln(currRAM,' bytes free');
  222.   end;
  223.  
  224.   { demo free again }
  225.   textcolor(lightred);
  226.   writeln('Now freeing reserved memory');
  227.   free(p);
  228.   textcolor(lightgray);
  229.   if (AllocError <> 0) then
  230.     writeln('free farmalloc error = ',MemError[AllocError])
  231.   else
  232.     writeln('previously allocated memory freed');
  233.   writeln(farcoreleft,' bytes free');
  234.   textcolor(yellow);
  235.   write('press any key to continue...');
  236.   ch := readkey;
  237.   textcolor(lightgray);
  238.  
  239.  
  240.   { now demo some actual use of allocated RAM:                               }
  241.   {                                                                          }
  242.   {    1.  Use calloc(fillpattern, size) to fill a newly allocated 1000 byte }
  243.   {        RAM buffer with a graphics char, and then write the individual    }
  244.   {        char from memory using Mem[].  Note the use of Mem[], seg(),      }
  245.   {        and the pointer pbuffer[1], along with 'i' used as the address    }
  246.   {        of Mem[], to access the allocated memory.  Since addresses are    }
  247.   {        0-based, 'i' ranges from 0 to 999 (n-1).  The chr() function is   }
  248.   {        then used to convert that location to a char for write().         }
  249.   {                                                                          }
  250.   {    2.  Fill some screens, save the results to RAM using malloc(), then   }
  251.   {        swap them back to the screen using move(src,des,size).            }
  252.  
  253.  
  254.   { use calloc(), fill the RAM with char 178 (▓); you could use any ch 0-255 }
  255.   pbuffer[1] := calloc(178,1000);
  256.   if (pbuffer[1] = NIL) then begin
  257.     writeLn('calloc error = ',MemError[AllocError]);
  258.     halt(1);
  259.     end;
  260.   clrscr;
  261.   textcolor(lightgreen);
  262.  
  263.   { now access the memory locations of the newly cleared allocation }
  264.   for i := 0 to 999 do
  265.      write(chr( Mem[ seg(pbuffer[1]^) : i] ));
  266.  
  267.   gotoxy(1,23);
  268.   textcolor(lightcyan);
  269.   writeln('calloc(',#178,',1000):  requested a block of RAM and cleared it with char ',#178,'.');
  270.   textcolor(lightgray);
  271.   write('press any key to continue...');
  272.   ch := readkey;
  273.   { free up RAM }
  274.   free(pbuffer[1]);
  275.  
  276.  
  277.   { find the video adapter (mono or color) prior to using move() }
  278.   videoptr := initvideo;
  279.   count := 1;
  280.  
  281.   { seq. point to allocated memory with a pointer from an array of pointers }
  282.   repeat
  283.     gotoxy(1,1);
  284.     pbuffer[count] := malloc(ScreenSize);
  285.     if (pbuffer[count] = NIL) then begin
  286.       writeLn('malloc error = ',MemError[AllocError]);
  287.       halt(1);
  288.       end;
  289.  
  290.     { now here's something original:  fill the screen with numbers }
  291.     textcolor((count+8) mod 15);
  292.     for i := 1 to 80 do begin
  293.       for j := 1 to 25 do begin
  294.         write(count);
  295.         end;
  296.       end;
  297.     textcolor(lightgray);
  298.  
  299.     { store the screen at the allocated position }
  300.     move(videoptr^, pbuffer[count]^, ScreenSize);
  301.     inc(count);
  302.   until (count = MaxNum);
  303.  
  304.   { now restore screen from RAM to video memory, changing with readkey }
  305.   textcolor(lightred);
  306.   for count := 1 to MaxNum-1 do begin
  307.     { wham! there's a new image }
  308.     move(pbuffer[count]^, videoptr^, ScreenSize);
  309.     gotoxy(1,25); clreol;
  310.     write('Here is screen ',count,' again using move().  press any key to continue...');
  311.     ch := readkey;
  312.     end;
  313.  
  314.   { let's see pbuffer 1 again:  wham! }
  315.   move(pbuffer[1]^, videoptr^, ScreenSize);
  316.   gotoxy(1,25); clreol;
  317.   write('And the 1st screen one more time.  press any key to continue...');
  318.   ch := readkey;
  319.  
  320.   { and finally pbuffer MaxNum-1 again:  wham! }
  321.   move(pbuffer[MaxNum-1]^, videoptr^, ScreenSize);
  322.   gotoxy(1,25); clreol;
  323.   write('And finally, the last screen one more time.  press any key to continue...');
  324.   ch := readkey;
  325.  
  326.   { and before exiting, free-up RAM }
  327.   clrscr;
  328.   textcolor(lightred);
  329.   writeln('Memory conditions before freeing RAM with video images');
  330.   textcolor(lightgray);
  331.   writeln(farcoreleft,' bytes free');
  332.   writeln;
  333.   for count := 1 to MaxNum-1 do
  334.      { no error checking is done }
  335.      free(pbuffer[count]);
  336.  
  337.   { verify all RAM was freed, comparing to starting RAM }
  338.   textcolor(lightred);
  339.   writeln('Memory conditions after freeing RAM with video images');
  340.   textcolor(lightgray);
  341.   currRAM := farcoreleft;
  342.   writeln(initialRAM,' bytes free at the start of this program');
  343.   writeln(currRAM,' bytes free after calling free(pbuffer[count])');
  344.   writeln;
  345.  
  346.   { it if doesn't equal zero we're in trouble }
  347.   writeln('difference between start and finishing RAM is: ',currRAM-initialRAM);
  348.   writeln;
  349.   writeln;
  350.   textcolor(yellow);
  351.   write('press any key to end demo...');
  352.   ch := readkey;
  353.   textcolor(lightgray);
  354. end.
  355.  
  356.